home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / comm2 / mmsndm61.lha / MM / Rexx / MM_SendMsg.rexx.cmp < prev    next >
Text File  |  1996-04-14  |  10KB  |  19 lines

  1. /*
  2.  
  3.                       $VER: MM_SendMsg 0.61/c  (14.03.96)
  4.  
  5.                            (C) 1994-96 Robert Hofmann
  6.  
  7. */
  8. parse arg opts;options cache;options failat 99;options results;signal on break_c;signal on break_d;signal on break_e;signal on break_f;signal on halt;signal on ioerr;signal on syntax;address 'MAILMANAGER';Main:;call Init;call Header;call Parse_Args(opts);call Wait_AreasWindow;call Send_Msg;call Quit(0, 'All done.');exit;Add_Clip: procedure;arg area .;tmp = getclip('MM_EXPORT');if find(tmp, area)=0 then call setclip('MM_EXPORT', tmp area);return;break_c:; break_d:; break_e:; break_f:; halt:;return_code = 5;error_line = 0;error_msg = 'Execution halted!!!';rc = 0;signal Exit;Exit:;signal off break_c;signal off break_d;signal off break_e;signal off break_f;signal off halt;signal off ioerr;signal off syntax;select;when return_code>=40 then error = 'INTERNAL-ERROR:';when return_code>=30 then error = 'IO-ERROR:';when return_code>=20 then error = 'ERROR:';when return_code>=10 then error = 'WARNING:';when return_code>=5 then error = 'INFO:';otherwise error = '';end;call Log()
  9. call Log('***' strip(error error_msg) '***', '+');call Log(,'\');call setclip('MM_LogPre', system.mm.logpre);exit return_code;Get_Arg: procedure Expose args system.;arg keyword, mode, old;p = find(upper(args), keyword);select;when mode=0 then if p>0 then do;ret = 1;args = delword(args, p, 1);end;else ret = old;when mode=1 then if p>0 then do;left = subword(args, 1, p-1);rest = subword(args, p+1);if left(rest, 1)='"' then parse var rest . '"' ret '"' rest;else parse var rest ret rest;args = strip(left strip(rest));end;else ret = old;when mode=2 then do;if left(args, 1)='"' then parse var args . '"' ret '"' args;else parse var args ret args;if strip(ret)='' then ret = old;end;otherwise exit 99;end;args = strip(args);ret = strip(ret, 'b', '" ');return ret;Get_Name: procedure Expose area. system.;parse arg address;MM_GetNodelistNode address 'tmp';if rc>0 then if find(system.addresses, upper(address))>0 then if system.mm.release<429 then do; MM_GetSysop 'ret'; end;else ret = area.alias;else ret = 'Sysop'
  10. else ret = tmp.sysop;return ret;Get_Version: procedure;parse arg mode;parse value sourceline(3-mode) with . . ver .;parse var ver tst 'ß' .;if ~datatype(strip(tst, 'b', '/ce '), 'N') then if ~mode then ver = Get_Version(1);else exit 99;return ver;Header:;call Log(,'/');call Log('***' system.prg.id '***', '+');call Log(' ' system.prg.cr);call Log();return;Include_Lib: procedure;parse arg lib, prio;if right(upper(lib), 8)~='.LIBRARY' then lib=lib'.library';if prio='' then prio=0;if ~show('l', lib) then if ~addlib(lib, prio, -30, 0) then do;say '*** ERROR: Could not open' lib'!!! ***';exit 10;end;return;Init:;system. = 0;MM_GetTaskPri 'system.taskpri';call pragma('p', system.taskpri);system.prg.name = 'MM_SendMsg';system.prg.ver = Get_Version(0);system.prg.id = system.prg.name 'v'system.prg.ver;system.prg.cr = '(C) 1994-96 Robert Hofmann';system.tmpfile = 'T:'system.prg.name'.tmp';system.tearline = system.prg.id;system.mm.logpre = getclip('MM_LogPre');system.prg.logpre = system.mm.logpre'|'
  11. call setclip('MM_LogPre', system.prg.logpre);system.cmdopts = 'AREA/A,MSGFILE/A,SUBJECT/A,FROMNAME/K,FROMADDR/K,TONAME/K,TOADDR/K,' || 'FLAGS/K/M,ORIGIN/K,DELETE/S,EXPORT/S,SPLIT/K/N,QUEUE/S';MM_Version 'system.mm';MM_GetAddrs 'system.addr';system.addresses = '';do n=0 to system.addr.count-1;system.addresses = system.addresses system.addr.n;end;upper system.addresses;call Include_Lib('rexxsupport');return;IOerr:;return_code = 20;error_line = sigl;error_msg = 'IO-error' rc 'at line' sigl '['errortext(rc)']');rc = 0;signal Exit;Log: procedure Expose system.;parse arg text, pre;tmp = word('PRG MM', (pre~='')+1);text = system.tmp.logpre || pre' 'text;MM_WriteLog 'text' '2';return;Make_5D: procedure;parse arg left '/' node '@' domain ., . '@' dmn .;parse var node node '.' point .;if point='' then point = 0;if domain='' then domain = dmn;return left'/'node'.'point'@'domain;Parse_Args: procedure Expose msg. system.;parse arg args;args = translate(args, ' ', '9'x);if find(args, '?')>0 then signal Usage
  12. if length(args)-length(compress(args, ','))<=4 then do;call Parse_Args2(args);msg.area = system.arg.area;msg.delete = system.arg.delete;msg.export = system.arg.export;msg.flags = upper(system.arg.flags);msg.from = system.arg.fromname;msg.fromaddr = system.arg.fromaddr;msg.msgfile = system.arg.msgfile;msg.origin = system.arg.origin;msg.subj = system.arg.subject;msg.to = system.arg.toname;msg.toaddr = system.arg.toaddr;end;else;do;parse var args msg.area . ',' msg.from ',' msg.fromaddr . ',' msg.to ',' msg.toaddr . ',' msg.msgfile . ',' msg.flags ',' msg.subj ',' msg.origin;msg.from = strip(msg.from);msg.to = strip(msg.to);msg.origin = strip(msg.origin);msg.subj = strip(msg.subj);upper msg.flags;dtmp = find(msg.flags, 'DELETEFILE');msg.delete = dtmp>0;ftmp = find(msg.flags, 'EXPORT');msg.export = ftmp>0;if msg.delete then msg.flags = delword(msg.flags, dtmp, 1);if msg.export then msg.flags = delword(msg.flags, ftmp, 1);msg.flags = strip(msg.flags);end;return;Parse_Args2: procedure Expose system.;parse arg args
  13. tpl = system.cmdopts',?/S,';args = translate(args, '  ', '9'x'=');pk = pos('/K', tpl);ps = pos('/S', tpl);select;when pk=0 & ps=0 then p = 0;when pk=0 & ps>0 then p = ps;when ps=0 & pk>0 then p = pk;otherwise p = min(pk, ps);end;p = lastpos(',', left(tpl, p));tpl = substr(tpl, p+1) || left(tpl, max(p-1, 0));do while tpl~='';parse var tpl template ',' tpl;parse var template keyword '/' .;bool = pos('/S', template)>0;key = pos('/K', template)>0;must = pos('/A', template)>0;num = pos('/N', template)>0;select;when must then system.arg.keyword = '0'x;when bool then system.arg.keyword = 0;when num then system.arg.keyword = 0;otherwise system.arg.keyword = '';end;if bool | key then mode = ~bool;else mode = 2;system.arg.keyword = Get_Arg(keyword, mode, system.arg.keyword);if keyword='?' & system.arg.keyword=1 then leave;if must & system.arg.keyword='0'x then do;tmp = template 'missing!!!';say;say ' ***' tmp '***';signal Usage;end;if num & ~datatype(system.arg.keyword, 'N') then
  14. if ~must & system.arg.keyword='' then system.arg.keyword = 0;else;do;tmp = 'Numeric value expected for' template', but is "'system.arg.keyword'"!!!';say;say ' ***' tmp '***';signal Usage;end;end;tmp = '?'; if system.arg.tmp then signal Usage;if args~='' then call Quit(10, 'Unknown option(s):' args);if system.arg.export & system.arg.queue then call Quit(11, 'You must not use EXPORT/S together with QUEUE/S!!!');return;Quit:;parse arg return_code, error_msg;error_line = 0;rc = 0;signal Exit;Replace: procedure;parse arg string, new, old;do while index(string, old)~=0;interpret "parse var string l '"old"' r";string = l || new || r;end;return string;Request_Choice: procedure Expose system.;parse arg text, buttons, ret_vals;title = system.prg.name'-Requester';text = translate(Replace(text, '0A'x, '\n'), '1b'x, '\');if length(text)<40 then text = center(text, 40);MM_Requester title 'text' 'buttons';if rc=0 then rc=words(ret_vals);return compress(word(ret_vals, rc), '_');Send_Msg: procedure Expose msg. system.
  15. if msg.area='' then call Quit(21, 'No area selected!!!');if ~exists(msg.msgfile) then call Quit(31, '"'msg.msgfile'" does not exist!!!');MM_GetAreaInfo msg.area 'area';if rc>0 then call Quit(22, 'Unknown area!!!');if area.type='TICK' then call Quit(11, 'Please use MM_Hatch for TICK-areas!!!');if msg.fromaddr='' then msg.fromaddr = area.addr;if msg.from='' then msg.from = Get_Name(msg.fromaddr);if msg.to='' then msg.to = Get_Name(msg.toaddr);MM_DeleteFile system.tmpfile;MM_CopyFile msg.msgfile system.tmpfile;if rc>0 then call Quit(32, 'Unable to create file "'system.tmpfile'"!!!');if area.type='MAIL' then do;if msg.toaddr='' then call Quit(23, 'DESTINATION-address missing!!!');info = 'Sending net';msg.file = system.tmpfile;msg.fromaddr = Make_5D(msg.fromaddr, area.addr);msg.toaddr = Make_5D(msg.toaddr, area.addr);drop msg.origin;end;else;do;info = 'Posting ';msg.toaddr = '';msg.fromaddr = '';end;msg.tear = system.tearline;msgfiles. = 0;if system.arg.split>0 then
  16. if (word(statef(system.tmpfile)'0 0', 2)+512)%1024>system.arg.split then do;call Log(' Splitting file...');MM_ReadStem system.tmpfile 'text';len = 0;max = system.arg.split*1024;split. = 0;do n=0 to text.count-1;if len>max then call Write_Split;len = len+length(text.n)+1;MM_AddToStem 'split' 'text.'n;end;if split.count>1 then call Write_Split;end;if msgfiles.count=0 then MM_AddToStem 'msgfiles' 'system.tmpfile';subject = msg.subj;cntlen = length(msgfiles.count);do n=0 to msgfiles.count-1;tmp = ' 'info'mail #'n+1 'in' upper(msg.area) 'from' strip(msg.from',' msg.fromaddr, 'b', ', ') 'to' strip(msg.to',' msg.toaddr, 'b', ', ');call Log(tmp);msg.file = msgfiles.n;if area.type='MAIL' then do;tmp.0 = '';tmp.1 = '---' system.tearline;tmp.count = 2;MM_WriteStem msg.file 'tmp' 'APPEND';end;if msgfiles.count>1 then msg.subj = subject '['right(n+1, cntlen, '0')'/'msgfiles.count']';MM_WriteMsg msg.area 'msg';if rc>0 then call Quit(24, 'Unable to send the msg!!! MM-RC='rc);MM_DeleteFile msg.file;end;if msg.delete then do
  17. MM_DeleteFile msg.msgfile;tmp = ' -> MsgFile deleted.';call Log(tmp);end;if msg.export then MM_Export msg.area;if system.arg.queue then call Add_Clip(msg.area);drop msg.;return;Syntax:;return_code = 40;error_line = sigl;error_msg = 'Syntax-error' rc 'at line' sigl '['errortext(rc)']';rc = 0;signal Exit;Usage:;rx. = '';rx.0.0 = '[rx] ';rx.0.1 = '[.rexx]';m = pos('/e', system.prg.ver)>0;tmp = rx.m.0 || system.prg.name || rx.m.1;say;say 'Usage:' tmp system.cmdopts;say;call Quit(0, 'Usage requested.');Wait_AreasWindow: procedure Expose system.;MM_AreasWin;if rc=0 then return;bell = '07'x;cr = '0D'x;if Request_Choice('\c\n\1'system.prg.id'\0 is waiting.\n\nPlease go back to the Areas-Window as soon as possible!\n', '* _WAIT | _QUIT ', '0 1') then call Quit(5, 'Aborted by user.');tmp = 'Waiting for Areas-Window...';call writech(STDOUT, bell || tmp || cr);call Log(tmp,, 4);rc = 1;do while rc~=0;MM_AreasWin;call writech(STDOUT, bell);call Delay(250);end;return
  18. Write_Split: procedure Expose len msg. msgfiles. system. text. split.;call Log('  #'msgfiles.count+1'...', , 5);textfile = system.tmpfile'.'msgfiles.count+1;ety = '';MM_AddToStem 'split' 'ety';MM_AddToStem 'msgfiles' 'textfile';MM_WriteStem textfile 'split';len = 0;split. = 0;MM_AddToStem 'split' 'ety';return
  19.